home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jeditmodes / mh-mode.tcl < prev    next >
Encoding:
Text File  |  1995-02-10  |  4.3 KB  |  168 lines
  1. # mh-mode.tcl - mode for composing mail in MH
  2. ######################################################################
  3.  
  4. proc mode:mh:init { t } {
  5.   global JEDIT_MODEPREFS
  6.   
  7.   j:read_prefs -array JEDIT_MODEPREFS -prefix mh \
  8.     -directory ~/.tk/jeditmodes -file mh-defaults {
  9.     {textfont default}
  10.     {textwidth 80}
  11.     {textheight 24}
  12.     {textwrap char}
  13.     {sabbrev 0}
  14.     {dabbrev 0}
  15.     {autobreak 1}
  16.     {autoindent 0}
  17.     {savestate 0}
  18.     {buttonbar 1}
  19.     {menu,editor 1}
  20.     {menu,file 1}
  21.     {menu,edit 1}
  22.     {menu,prefs 0}
  23.     {menu,abbrev 1}
  24.     {menu,filter 1}
  25.     {menu,format 0}
  26.     {menu,display 0}
  27.     {menu,mode1 1}
  28.     {menu,mode2 1}
  29.     {menu,user 1}
  30.   }
  31.   
  32.   # catch {$t tag configure header -background LemonChiffon}
  33.   $t tag configure header -relief flat        ;# just to create it
  34.   $t tag lower header
  35.   catch {$t tag configure sig -font {-*-courier-bold-r-normal--10-100-*}}
  36.   $t tag lower sig
  37.   
  38.   # problematical: gets in the way of dabbrevs
  39.   #
  40.   bind $t <Double-Tab> "mode:mh:to_body $t"
  41.   bind $t <Tab> "mode:mh:next_header $t"
  42. }
  43.  
  44. ######################################################################
  45. # special hooks:
  46.  
  47. proc mode:mh:post_read_hook { filename t } {
  48.   set separator {}
  49.   if [regexp -indices "\n-*\n" [$t get 0.0 end] separator] {
  50.     set headerend [lindex $separator 0]
  51.     $t tag add header 0.0 "0.0 + $headerend chars + 1 char"
  52.   }
  53. }
  54.  
  55. ######################################################################
  56. # more procedures:
  57.  
  58. proc mode:mh:border { t } {
  59.   j:text:insert_string $t \
  60.     "     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n"
  61. }
  62.  
  63. # delete the signature if it exists (and is tagged so):
  64.  
  65. proc mode:mh:delete_sig { t } {
  66.   catch {
  67.     $t delete sig.first end
  68.   }
  69. }
  70.  
  71. proc mode:mh:insert_sig { t } {
  72.   global env
  73.   mode:mh:delete_sig $t
  74.   set curr [$t index end]
  75.   $t insert end "\n"
  76.   $t insert end [exec cat $env(HOME)/.signature]
  77.   $t insert end "\n"
  78.   $t tag add sig $curr end
  79. }
  80.  
  81. proc mode:mh:start_reply { t } {
  82.   set reply [exec cat "@" | sed {1,/^$/d} | \
  83.     sed {s/^>/  /} | sed {s/^/  /}]
  84.   $t insert end $reply
  85. }
  86.  
  87. proc mode:mh:whom { t } {
  88.   jedit:cmd:save $t
  89.   set filename [jedit:get_filename $t]
  90.   j:more -height 10 -width 60 -title "Recipients" \
  91.     -text [exec whom -check $filename]
  92. }
  93.  
  94. proc mode:mh:to_body { t } {
  95.   $t mark set insert end
  96.   $t yview -pickplace insert
  97. }
  98.  
  99. # BUG - doesn't handle multi-line headers.
  100.  
  101. proc mode:mh:next_header { t } {
  102.   if [$t compare header.last <= insert] {
  103.     $t mark set insert 1.0
  104.   }
  105.   
  106.   set headpart [$t get insert header.last]
  107.   
  108.   set regex [format {(^|%s)[A-Za-z-]*:[ %s]*} "\n" "\t"]
  109.   if [regexp -indices -- $regex $headpart indices] {
  110.     $t tag remove sel 1.0 end
  111.     set valuestart [expr [lindex $indices 1] + 1]
  112.     $t mark set hdrfrom "insert + $valuestart chars"
  113.     $t tag add sel hdrfrom {hdrfrom lineend}
  114.     $t mark set insert {hdrfrom lineend}
  115.     $t yview -pickplace insert
  116.   } else {
  117.     # assume we're in the last header field, so jump to body
  118.     mode:mh:to_body $t
  119.   }
  120. }
  121.  
  122. ######################################################################
  123. # define the MH menu:
  124. ######################################################################
  125.  
  126. proc mode:mh:mkmenu1 { menu t } {
  127.   menubutton $menu -text {MH} -menu $menu.m
  128.   
  129.   menu $menu.m
  130.   $menu.m add command -label {Start Reply} \
  131.     -accelerator {[2]} -command "
  132.     mode:mh:start_reply $t
  133.   "
  134.   $menu.m add command -label {Sign Email} -command "
  135.     mode:mh:insert_sig $t
  136.   "
  137.   $menu.m add command -label {List Recipients} \
  138.     -accelerator {[7]} -command "
  139.     mode:mh:whom $t
  140.   "
  141.   $menu.m add command -label {Insert Border} \
  142.     -accelerator {[8]} -command "
  143.     mode:mh:border $t
  144.   "
  145.   $menu.m add command -label {Done} -command "
  146.     jedit:cmd:done $t
  147.   "
  148.   
  149.   bind $t <Meta-Key-2> "mode:mh:start_reply $t"
  150.   bind $t <Meta-Key-7> "mode:mh:whom $t"
  151.   bind $t <Meta-Key-8> "mode:mh:border $t"
  152. }
  153. ######################################################################
  154. # define the button bar:
  155. ######################################################################
  156.  
  157. proc mode:mh:mkbuttons { w t } {
  158.   j:buttonbar $w -pady 2 -buttons [format {
  159.     {done Done {jedit:cmd:done %s}}
  160.     {border {* * *} {mode:mh:border %s}}
  161.     {whom Whom {mode:mh:whom %s}}
  162.     {sign Sign {mode:mh:insert_sig %s}}
  163.     {reply {@} {mode:mh:start_reply %s}}
  164.   } $t $t $t $t $t]
  165.   return $w
  166. }
  167.  
  168.